perm filename PICGRA.SAI[VIS,HPM]6 blob
sn#390275 filedate 1978-10-25 generic text, type T, neo UTF8
OWN REAL PXLO,PXHI,PYLO,PYHI; OWN INTEGER PPIC;
PROCEDURE PSCREEN(REAL XL,YL,XH,YH; REFERENCE INTEGER PC);
BEGIN
PXLO←XL;
PXHI←XH;
PYLO←YL;
PYHI←YH;
PPIC←LOCATION(PC);
END;
PROCEDURE DIT(REAL X1,Y1,BRITE);
BEGIN
X1←(MEMORY[PPIC+LNBY]-1.9)*(X1-PXLO)/(PXHI-PXLO);
Y1←(MEMORY[PPIC+PCLN]-1.9)*(Y1-PYHI)/(PYLO-PYHI);
BRITE←BRITE*MEMORY[PPIC+BMAX];
ADDIEL(MEMORY[PPIC],Y1,X1,BRITE);
END;
PROCEDURE THIN(REAL X1,Y1,X2,Y2,BRITE);
BEGIN
REAL LEN,DX,DY; REAL I; INTEGER ILEN;
X1←(MEMORY[PPIC+LNBY]-1.9)*(X1-PXLO)/(PXHI-PXLO);
Y1←(MEMORY[PPIC+PCLN]-1.9)*(Y1-PYHI)/(PYLO-PYHI);
X2←(MEMORY[PPIC+LNBY]-1.9)*(X2-PXLO)/(PXHI-PXLO);
Y2←(MEMORY[PPIC+PCLN]-1.9)*(Y2-PYHI)/(PYLO-PYHI);
BRITE←BRITE*MEMORY[PPIC+BMAX];
DX←X2-X1; DY←Y2-Y1; DX←DX; DY←DY;
ILEN←LEN←SQRT(DX↑2+DY↑2);
DX←DX/LEN; DY←DY/LEN;
FOR I←0 STEP 0.5 UNTIL LEN DO
ADDIEL(MEMORY[PPIC],Y1+DY*I,X1+DX*I,BRITE/2);
COMMENT ADDIEL(MEMORY[PPIC],Y2,X2,(LEN-ILEN)*BRITE);
END;
PROCEDURE FADE(REAL X1,Y1,X2,Y2,BRITE1,BRITE2);
BEGIN
REAL LEN,DX,DY; INTEGER I,ILEN;
X1←(MEMORY[PPIC+LNBY]-1.9)*(X1-PXLO)/(PXHI-PXLO);
Y1←(MEMORY[PPIC+PCLN]-1.9)*(Y1-PYHI)/(PYLO-PYHI);
X2←(MEMORY[PPIC+LNBY]-1.9)*(X2-PXLO)/(PXHI-PXLO);
Y2←(MEMORY[PPIC+PCLN]-1.9)*(Y2-PYHI)/(PYLO-PYHI);
BRITE1←BRITE1*MEMORY[PPIC+BMAX];
BRITE2←BRITE2*MEMORY[PPIC+BMAX];
DX←X2-X1; DY←Y2-Y1;
ILEN←LEN←SQRT(DX↑2+DY↑2);
DX←DX/LEN; DY←DY/LEN;
FOR I←0 STEP 1 UNTIL ILEN-1 DO
ADDIEL(MEMORY[PPIC],Y1+DY*I,X1+DX*I,(BRITE2*I+BRITE1*(ILEN-I))/ILEN);
ADDIEL(MEMORY[PPIC],Y2,X2,(LEN-ILEN)*BRITE2);
END;
PROCEDURE BALL(REAL X1,Y1,X2,Y2,BRITE);
BEGIN
REAL LEN,DX,DY,XR,YR,XC,YC,T;
X1←(MEMORY[PPIC+LNBY]-1.9)*(X1-PXLO)/(PXHI-PXLO);
Y1←(MEMORY[PPIC+PCLN]-1.9)*(Y1-PYHI)/(PYLO-PYHI);
X2←(MEMORY[PPIC+LNBY]-1.9)*(X2-PXLO)/(PXHI-PXLO);
Y2←(MEMORY[PPIC+PCLN]-1.9)*(Y2-PYHI)/(PYLO-PYHI);
BRITE←BRITE*MEMORY[PPIC+BMAX];
XC←(X1+X2)/2;
YC←(Y1+Y2)/2;
XR←(X1-X2)/2;
YR←(Y1-Y2)/2;
T←0;
WHILE T<2*3.14159265 DO
BEGIN
REAL X,Y;
X←XR*COS(T); Y←YR*SIN(T);
ADDIEL(MEMORY[PPIC],YC+Y,XC+X,BRITE);
T←T+1/SQRT(X↑2+Y↑2);
END;
END;
PROCEDURE CPOLY(INTEGER N; REFERENCE REAL XV,YV; REAL BRITE);
BEGIN "POLY"
REQUIRE "{}" DELIMITERS;
REAL XMIN,XMAX,YMIN,YMAX; INTEGER LOX,HIX,LOY,HIY,M;
REAL ARRAY IX,IY[0:N-1];
REAL LEDGE,LEX,LEDX,LAST;
REAL REDGE,REX,REDX,RAST;
INTEGER LNXT,RNXT,I,J,LINENO,LOWY,HIGY;
DEFINE X(I)={MEMORY[LOCATION(XV)+I,REAL]};
DEFINE Y(I)={MEMORY[LOCATION(YV)+I,REAL]};
M←N-1; LOX←HIX←LOY←HIY←1;
XMIN←XMAX←IX[0]←(MEMORY[PPIC+LNBY]-1.9)*(X(0)-PXLO)/(PXHI-PXLO);
YMIN←YMAX←IY[0]←(MEMORY[PPIC+PCLN]-1.9)*(Y(0)-PYHI)/(PYLO-PYHI);
BRITE←BRITE*MEMORY[PPIC+BMAX];
FOR I←1 STEP 1 UNTIL M DO
BEGIN
IX[I]←(MEMORY[PPIC+LNBY]-1.9)*(X(I)-PXLO)/(PXHI-PXLO);
IY[I]←(MEMORY[PPIC+PCLN]-1.9)*(Y(I)-PYHI)/(PYLO-PYHI);
IF IX[I]<XMIN THEN BEGIN LOX←I; XMIN←IX[I] END;
IF IY[I]<YMIN THEN BEGIN LOY←I; YMIN←IY[I] END;
IF IX[I]>XMAX THEN BEGIN HIX←I; XMAX←IX[I] END;
IF IY[I]>YMAX THEN BEGIN HIY←I; YMAX←IY[I] END;
END;
LEDGE←REDGE←LOY;
LEX ← IX[LEDGE]; LNXT←(LEDGE+1) MOD N;
LEDX←(IX[LEDGE]-IX[LNXT])/(IY[LEDGE]-IY[LNXT]);
LAST← IY[LNXT];
REX ← IX[REDGE]; RNXT←(REDGE+N-1) MOD N;
REDX←(IX[REDGE]-IX[RNXT])/(IY[REDGE]-IY[RNXT]);
RAST← IY[RNXT];
LOWY←YMIN+.5; HIGY←YMAX-0.5;
FOR LINENO←LOWY STEP 1 UNTIL HIGY DO
BEGIN
REAL J;
WHILE LINENO>LAST ∧ LEDGE≠HIY DO
BEGIN
LEDGE←LNXT;
LEX ← IX[LEDGE]; LNXT←(LEDGE+1) MOD N;
LEDX←(IX[LEDGE]-IX[LNXT])/(IY[LEDGE]-IY[LNXT]);
LAST← IY[LNXT];
END;
WHILE LINENO>RAST ∧ REDGE≠HIY DO
BEGIN
REDGE←RNXT;
REX ← IX[REDGE]; RNXT←(REDGE+N-1) MOD N;
REDX←(IX[REDGE]-IX[RNXT])/(IY[REDGE]-IY[RNXT]);
RAST← IY[RNXT];
END;
FOR J←LEX STEP 1 UNTIL REX DO PUTEL(MEMORY[PPIC],LINENO,J,BRITE);
LEX←LEX+LEDX;
REX←REX+REDX;
END;
END "POLY";
PROCEDURE FPOLY(INTEGER N; REFERENCE REAL XV,YV; REAL BRITE);
BEGIN "POLY"
REQUIRE "{}" DELIMITERS;
REAL ARRAY IX,IY[0:N-1];
REAL YMIN,YMAX; INTEGER M;
REAL LX1,LX2,LY1,LY2;
REAL RX1,RX2,RY1,RY2;
INTEGER LEDGE,REDGE,LNXT,RNXT,I,J,LINENO,LOWY,HIGY,LOWX,HIGX;
DEFINE X(I)={MEMORY[LOCATION(XV)+I,REAL]};
DEFINE Y(I)={MEMORY[LOCATION(YV)+I,REAL]};
M←N-1; LEDGE←0;
IX[0]←MEMORY[PPIC+LNBY]*(X(0)-PXLO)/(PXHI-PXLO);
YMIN←YMAX←IY[0]←MEMORY[PPIC+PCLN]*(Y(0)-PYHI)/(PYLO-PYHI);
BRITE←BRITE*MEMORY[PPIC+BMAX];
FOR I←1 STEP 1 UNTIL M DO
BEGIN
IX[I]←MEMORY[PPIC+LNBY]*(X(I)-PXLO)/(PXHI-PXLO);
IY[I]←MEMORY[PPIC+PCLN]*(Y(I)-PYHI)/(PYLO-PYHI);
IF IY[I]<YMIN THEN BEGIN LEDGE←I; YMIN←IY[I] END;
IF IY[I]>YMAX THEN YMAX←IY[I];
END;
REDGE←LEDGE;
LX1 ← IX[LEDGE];
LY1 ← IY[LEDGE];
LNXT←(LEDGE+1) MOD N;
LX2 ← IX[LNXT];
LY2 ← IY[LNXT];
RX1 ← IX[REDGE];
RY1 ← IY[REDGE];
RNXT←(REDGE+N-1) MOD N;
RX2 ← IX[RNXT];
RY2 ← IY[RNXT];
LOWY←YMIN+0.5; HIGY←YMAX-0.5;
LOWY←LOWY MAX 0; HIGY←HIGY MIN (MEMORY[PPIC+PCLN]-1);
FOR LINENO←LOWY STEP 1 UNTIL HIGY DO
BEGIN
WHILE LY2<LINENO+.5 DO
BEGIN
LEDGE←LNXT;
LX1 ← LX2;
LY1 ← LY2;
LNXT←(LEDGE+1) MOD N;
LX2 ← IX[LNXT];
LY2 ← IY[LNXT];
END;
WHILE RY2<LINENO+.5 DO
BEGIN
REDGE←RNXT;
RX1 ← RX2;
RY1 ← RY2;
RNXT←(REDGE+N-1) MOD N;
RX2 ← IX[RNXT];
RY2 ← IY[RNXT];
END;
LOWX ← (LINENO+.5-LY1)*(LX2-LX1)/(LY2-LY1)+LX1 + 0.5;
HIGX ← (LINENO+.5-RY1)*(RX2-RX1)/(RY2-RY1)+RX1 - 0.5;
LOWX←LOWX MAX 0;
HIGX←HIGX MIN MEMORY[PPIC + LNBY];
FOR J←LOWX STEP 1 UNTIL HIGX DO PUTEL(MEMORY[PPIC],LINENO,J,BRITE);
END;
END "POLY";
IFC FALSE THENC
PROCEDURE PIXLIN(REAL X1,Y1,X2,Y2,BR;
REFERENCE INTEGER PIC;
REAL XLO(0),YLO(0),XHI(1),YHI(1));
BEGIN
SAFE REAL ARRAY WT[-1:1,-1:1];
REAL LEN,DX,DY,DTX,DTY,TX,TY,T,CON; INTEGER IX,IY,IDX,IDY;
X1←MEMORY[LOCATION(PIC)+LNBY]*(X1-XLO)/(XHI-XLO);
X2←MEMORY[LOCATION(PIC)+LNBY]*(X2-XLO)/(XHI-XLO);
Y1←MEMORY[LOCATION(PIC)+PCLN]*(Y1-YLO)/(YHI-YLO);
Y2←MEMORY[LOCATION(PIC)+PCLN]*(Y2-YLO)/(YHI-YLO);
DX←X2-X1; DY←Y2-Y1;
IDX←IF DX>0 THEN 1 ELSE -1;
IDY←IF DY>0 THEN 1 ELSE -1;
LEN←SQRT(DX↑2+DY↑2);
DTX←ABS(LEN/(X2-X1)); DTY←ABS(LEN/(Y2-Y1));
IX←X1; IY←Y1;
TX←(X1-IX)/DX; IF TX<0 THEN TX←(X1-IX-1)/DX;
TX←TX*SQRT(1+DY↑2);
TY←(Y1-IY)/DY; IF TY<0 THEN TY←(Y1-IY-1)/DY;
TY←TY*SQRT(1+DX↑2);
T←0;
BR←BR*MEMORY[LOCATION(PIC)+BMAX]/SQRT(2);
CON←X1*Y2-X2*Y1;
OUTSTR("BR "&CVF(BR)&" TX "&CVF(TX)&" TY "&CVF(TY)&" DTX "&CVF(DTX)&" DTY "&CVF(DTY)&'15&'12);
WHILE T<LEN DO IF TX+DTX<TY+DTY THEN
BEGIN
INTEGER II,JJ; REAL VAL;
TX←(TX+DTX) MIN LEN;
VAL←0;
FOR II←-1,0,1 DO
FOR JJ←-1,0,1 DO
BEGIN
WT[II,JJ]←(LEN-ABS((II+IY)*DX-(JJ+IX)*DY+CON)) MAX 0;
VAL←VAL+WT[II,JJ];
END;
FOR II←-1,0,1 DO
FOR JJ←-1,0,1 DO
ADDEL(PIC,II+IY,JJ+IX,BR*(TX-T)*WT[II,JJ]/VAL);
T←TX;
IX←IX+IDX;
END
ELSE
BEGIN
INTEGER II,JJ; REAL VAL;
TY←(TY+DTY) MIN LEN;
VAL←0;
FOR II←-1,0,1 DO
FOR JJ←-1,0,1 DO
BEGIN
WT[II,JJ]←(LEN-ABS((II+IY)*DX-(JJ+IX)*DY+CON)) MAX 0;
VAL←VAL+WT[II,JJ];
END;
FOR II←-1,0,1 DO
FOR JJ←-1,0,1 DO
ADDEL(PIC,II+IY,JJ+IX,BR*(TX-T)*WT[II,JJ]/VAL);
T←TY;
IY←IY+IDY;
END;
END;
PROCEDURE PICLIN(REAL X1,Y1,X2,Y2,BR;
REFERENCE INTEGER PIC;
REAL XLO(0),YLO(0),XHI(1),YHI(1));
BEGIN
REAL LEN,DX,DY,DTX,DTY,TX,TY,T; INTEGER IX,IY,IDX,IDY;
X1←MEMORY[LOCATION(PIC)+LNBY]*(X1-XLO)/(XHI-XLO);
X2←MEMORY[LOCATION(PIC)+LNBY]*(X2-XLO)/(XHI-XLO);
Y1←MEMORY[LOCATION(PIC)+PCLN]*(Y1-YLO)/(YHI-YLO);
Y2←MEMORY[LOCATION(PIC)+PCLN]*(Y2-YLO)/(YHI-YLO);
DX←X2-X1; DY←Y2-Y1;
IDX←IF DX>0 THEN 1 ELSE -1;
IDY←IF DY>0 THEN 1 ELSE -1;
LEN←SQRT(DX↑2+DY↑2);
DTX←ABS(LEN/(X2-X1)); DTY←ABS(LEN/(Y2-Y1));
IX←X1; IY←Y1;
TX←(X1-IX)/DX; IF TX<0 THEN TX←(X1-IX-1)/DX;
TX←TX*SQRT(1+DY↑2);
TY←(Y1-IY)/DY; IF TY<0 THEN TY←(Y1-IY-1)/DY;
TY←TY*SQRT(1+DX↑2);
T←0;
BR←BR*MEMORY[LOCATION(PIC)+BMAX]/SQRT(2);
OUTSTR("BR "&CVF(BR)&" TX "&CVF(TX)&" TY "&CVF(TY)&" DTX "&CVF(DTX)&" DTY "&CVF(DTY)&'15&'12);
WHILE T<LEN DO IF TX+DTX<TY+DTY THEN
BEGIN
TX←(TX+DTX) MIN LEN;
ADDEL(PIC,IY,IX,(TX-T)*BR);
T←TX;
IX←IX+IDX;
END
ELSE
BEGIN
TY←(TY+DTY) MIN LEN;
ADDEL(PIC,IY,IX,(TY-T)*BR);
T←TY;
IY←IY+IDY;
END;
END;
ENDC